home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
007
/
simcode.arc
/
GETPUT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1984-12-23
|
6KB
|
180 lines
{$symtab-,$pagesize:84,$linesize:131,$debug-,
$title:'GETPUT.PAS -- Get from Comm Line and Put to CRT'}
{ COPYRIGHT @ 1982
Jim Holtman and Eric Holtman
35 Dogwood Trail
Randolph, NJ 07869
(201) 361-3395
}
module get_put;
{$include:'simterm.inc'}
var
[ external] insert_mode,prt_flag,lpt_only_flag : boolean;
direct_printer_flag : boolean;
display_mode : PRT_ATTR;
display_buffer_addr : word;
graftrax : boolean;
scroll_top : integer;
char_graphics : boolean; {true if I want to print chars >128}
retrace_flag : boolean;
silent_mode [external] : boolean;
procedure ck(a : integer;
const b :string);
external;
procedure save_line(line : CRT_SIZE;
inc : INC_LIMIT);
external;
procedure scan_line(const line : screen_buf);
external;
function com_get(var inch : char) : boolean;
external; {$include:'graph.inc'}
{$include:'comm.inc'}
procedure putchar(inchar : char);
const
NORMAL = 7;
UNDERLINE = 1;
INTENSE = #0a;
INTENSEUN = #09;
REVERSE = #70; {reverse video}
TAB = chr(9); {expand TABS}
BACKSP = chr(8); {back space}
var
x,y,ynow,xpos : integer;
attr_byte,ca : integer;
save_buf : screen_buf; {parameter for SCAN_LINE}
startb , endb : ads of char;
display_control [external] : boolean;
begin
if direct_printer_flag then begin
xlpt1(inchar);
return end;
xrcurp(x,y);
if (y >= BOTTOM) and ((inchar = NL) or (x = RIGHT_MAR)) then begin
xscrlup(1,scroll_top,BOTTOM);
xxmove(x,BOTTOM-1);
y := BOTTOM-1 end;
if inchar = TAB then begin
repeat
putchar(chr(xrca and #ff));
{output the same character so }
{TAB is non-distructive}
x := x+1
until (x mod 8) = 0;
{go to 8th position}
return end;
if insert_mode then begin
startb.s := display_buffer_addr;
endb.s := display_buffer_addr;
startb.r := wrd((y*(RIGHT_MAR+1) + x)*2);
endb.r := startb.r+2;
if retrace_flag then
movesr_wait(startb,endb,wrd((RIGHT_MAR-x)*2))
else movesr(startb,endb,wrd((RIGHT_MAR-x)*2));
end;
case display_mode of
PRT_NORMAL: attr_byte := NORMAL;
PRT_UNDERLINE: attr_byte := UNDERLINE;
PRT_SUPER: attr_byte := INTENSE;
PRT_SUB: attr_byte := INTENSEUN;
PRT_BOLD: attr_byte := REVERSE;
otherwise ;
end;
if (display_control = true) then begin
{special code for displaying control
characters}
if inchar < chr(#20) then begin
{this is a control character}
attr_byte := REVERSE;
inchar := chr(ord(inchar) + #40) end end;
{if BACK-SPACE and LEFT MARGIN, then backup a
line to handle}
{wrap around on a line correctly}
if (x=LEFT_MAR) and (inchar=BACKSP) then BEGIN
if y>TOP then xxmove(RIGHT_MAR,y-1)
else END
else xttywrt(inchar,attr_byte);
if lpt_only_flag or (graftrax and prt_flag) then xlpt1(inchar);
xrcurp(x,ynow); {cursor after read}
if ynow>y then begin {cursor moved down a line, so save it and }
{SCAN it for output to printer}
save_line(y,1);
if prt_flag and (not graftrax) then begin
startb.s := display_buffer_addr;
startb.r := wrd(2*y*80);
{find line in display area}
if retrace_flag then moves_wait(startb,ads save_buf,160)
{setup for call}
else movesl(startb,ads save_buf,160);
{setup for call}
scan_line(save_buf) end end;
end;
function getc(flag : LOOP_FLAG) : integer;
const
BREAK_OUT = #E; {Left Shift, Ctrl, and Alt are depressed}
var
inch : char;
parity_mask [public] : integer;
ignore_dels [external] : boolean;
bios_data_ptr [static] : adsmem;
err_flag [external] : byte;
lsr_value [external] : byte;
msr_value [external] : byte;
value parity_mask := #7F;
bios_data_ptr.s := #40; {address data area for DOS}
bios_data_ptr.r := 0;
begin
while (com_get(inch)) do begin
if flag = EXIT then begin
getc := -1;
return;
end;
if (bios_data_ptr^[#17] and BREAK_OUT) = BREAK_OUT then begin
getc := 0; {return NULL on a forced break out}
return;
end;
end;
getc := ord(inch) and parity_mask;
{If we are stripping DELs, then also drop the
next character}
if ignore_dels then BEGIN
while result(getc) = #7F do begin
eval(getc(HANG));
getc := getc(flag);
err_flag := 0; {ignore this error}
end END;
if not silent_mode and (err_flag<> 0) then begin
if (err_flag and 2#100)<>0 then xttywrt('Recv Buf Ovrflw',240);
if (err_flag and 2#1000)<>0 then
xttywrt('Stray THRE interrupt!',240);
if (err_flag and 2#10000)<>0 then
xttywrt('Char not XMITTED',240);
if ((err_flag and 2#10)<> 0) and ((msr_value and 2#10)<>0) then
xttywrt('DSR Changed',240);
if (err_flag and 1)<>0 then begin
if (lsr_value and 2#10)<>0 then xttywrt('Data Overrun',240);
if (lsr_value and 2#100)<>0 then xttywrt('Parity Error',240);
if (lsr_value and 2#1000)<>0 then xttywrt('Framing Error',240);
end;
err_flag := 0;
end;
end; end.